home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 24 / AMIGAplus Sonderheft 24 (2000)(Falke)(DE)[!].iso / Rexx / LoadAnimGif.pprx < prev    next >
Text File  |  1999-11-06  |  8KB  |  295 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: LoadAnimGif.pprx 1.4 */
  4.  
  5. /** ENG
  6.  This script loads a GIF animation, and then either displays it with the
  7.  proper timing, or converts it into an IFF anim-brush (if the "Anim-Brush"
  8.  option is selected).
  9.  
  10.  GIF animation features such as frame-by-frame timing, multiple palettes,
  11.  control blocks, offsets and overlays are supported. Multiple transparencies
  12.  are not supported.
  13. */
  14.  
  15. /** DEU
  16.  Mit Hilfe dieses Skripts läßt sich eine GIF-Animation laden und dann
  17.  entweder mit dem korrekten Timing anzeigen oder in einen IFF-Anim-Brush
  18.  konvertieren (sofern die Option "Anim-Brush" aktiviert ist).
  19.  
  20.  Merkmale von GIF-Animationen, wie frameweises Timing, unterschiedliche
  21.  Paletten, Control Blocks, Offsets und Overlays werden unterstützt.
  22.  Unterschiedliche Transparenzwerte werden nicht unterstützt.
  23. */
  24.  
  25. /** ITA
  26.  Questo script carica un'animazione GIF, e poi o la visualizza con
  27.  un'adeguata temporizzazione, o la converte in un anim-brush IFF
  28.  (se l'opzione "Anim-Brush" è selezionata).
  29.  
  30.  Sono riconosciute caratteristiche delle animazioni GIF come temporizzazione
  31.  fotogramma per fotogramma, tavolozze multiple, blocchi di controllo, offset
  32.  e sovrapposizioni. Non sono riconosciute trasparenze multiple.
  33. */
  34.  
  35. IF ARG(1, EXISTS) THEN
  36.     PARSE ARG PPPORT
  37. ELSE
  38.     PPPORT = 'PPAINT'
  39.  
  40. IF ~SHOW('P', PPPORT) THEN DO
  41.     IF EXISTS('PPaint:PPaint') THEN DO
  42.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  43.         DO 30 WHILE ~SHOW('P',PPPORT)
  44.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  45.         END
  46.     END
  47.     ELSE DO
  48.         SAY "Personal Paint could not be loaded."
  49.         EXIT 10
  50.     END
  51. END
  52.  
  53. IF ~SHOW('P', PPPORT) THEN DO
  54.     SAY 'Personal Paint Rexx port could not be opened'
  55.     EXIT 10
  56. END
  57.  
  58. ADDRESS VALUE PPPORT
  59. OPTIONS RESULTS
  60. OPTIONS FAILAT 10000
  61.  
  62. Get 'LANG'
  63. IF RESULT = 1 THEN DO        /* Deutsch */
  64.     txt_title_req     = 'GIF-Anim-Brush laden'
  65.     txt_gad_absh      = 'Anim-_Brush:'
  66.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  67.     txt_err_oldlib    = 'Für dieses Skript ist eine neuere Version_der GIF library erforderlich'
  68.     txt_err_load      = 'Fehler beim Laden'
  69.     txt_err_notagif   = 'Die ausgewählte Datei enthält keine GIF-Animation'
  70.     txt_err_notsupp   = 'Das ausgewählte Animationsformat kann nicht geladen werden.'
  71.     txt_err_scrfmt    = 'Bildschirmformat kann nicht benutzt werden'
  72. END
  73. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  74.     txt_title_req     = 'Leggere Anim-brush GIF'
  75.     txt_gad_absh      = 'Anim-_Brush:'
  76.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  77.     txt_err_oldlib    = 'Questa procedura richiede_una versione più recente_della libreria GIF'
  78.     txt_err_load      = 'Errore nelle lettura del file'
  79.     txt_err_notagif   = 'Il file selezionato_non contiene un''animazione GIF'
  80.     txt_err_notsupp   = 'Il tipo di animazione non può essere letto'
  81.     txt_err_scrfmt    = 'Il formato di schermo non può essere utilizzato'
  82. END
  83. ELSE DO                /* English */
  84.     txt_title_req     = 'Load GIF Anim-Brush'
  85.     txt_gad_absh      = 'Anim-_Brush:'
  86.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  87.     txt_err_oldlib    = 'This script requires a newer_version of the GIF library'
  88.     txt_err_load      = 'Load error'
  89.     txt_err_notagif   = 'The selected file_does not contain_a GIF animation'
  90.     txt_err_notsupp   = 'The selected animation type_cannot be loaded'
  91.     txt_err_scrfmt    = 'The screen format cannot be set'
  92. END
  93.  
  94. Version 'REXX'
  95. IF RESULT < 7 THEN DO
  96.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  97.     EXIT 10
  98. END
  99.  
  100. LockGUI
  101. RequestFile '"'txt_title_req'"'
  102. IF RC = 0 THEN DO
  103.     gfile = RESULT
  104.     getbsh = LoadSet('GetBsh', 1)
  105.  
  106.     Request '"'txt_title_req'" "CHECK = ""'txt_gad_absh'"", 'getbsh'"'
  107.     IF RC = 0 THEN DO
  108.         getbsh = RESULT.1
  109.         CALL SaveSet('GetBsh', getbsh)
  110.         frame = 1
  111.         loop = -1
  112.         delays = ''
  113.         err_msg = ''
  114.         setup = 1
  115.  
  116.         Get 'GCLIP'
  117.         saveclip = RESULT
  118.         Set '"GCLIP=0"'
  119.  
  120.         DO FOREVER
  121.             LoadBrush gfile 'QUIET NOPROGRESS FORMAT "GIF" OPTIONS "FRAME='frame'"'
  122.             IF RC = 0 THEN DO
  123.                 IF setup THEN DO
  124.                     setup = 0
  125.                     SwitchEnvironment
  126.                     FreeEnvironment 'QUERY'
  127.                     IF RC ~= 0 THEN
  128.                         LEAVE
  129.                     DeleteFrames 'ALL FORCE'
  130.                     SetPen 'BACKGROUND 0'
  131.                     ClearImage
  132.                     GetBrushAttributes 'COLORS'
  133.                     cnum = RESULT
  134.                     GetBrushAttributes 'WIDTH'
  135.                     brushw = RESULT
  136.                     GetBrushAttributes 'HEIGHT'
  137.                     brushh = RESULT
  138.                     IF SetScreenFormat(brushw, brushh, cnum, 1) ~= 0 THEN DO
  139.                         IF SetScreenFormat(brushw, brushh, cnum, 0) ~= 0 THEN DO
  140.                             err_msg = txt_err_scrfmt
  141.                             LEAVE
  142.                         END
  143.                     END
  144.                     GetBrushAttributes 'TRANSPARENCY'
  145.                     transp = RESULT
  146.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  147.                     transpcol = RESULT
  148.                     SetPen 'BACKGROUND' transpcol
  149.                     ClearImage
  150.                     AddFrames
  151.                 END
  152.                 ELSE DO
  153.                     GetBrushAttributes 'TRANSPARENCY'
  154.                     transp2 = RESULT
  155.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  156.                     transpcol2 = RESULT
  157.                     IF transp2 ~= transp | transpcol2 ~= transpcol THEN DO
  158.                         err_msg = txt_err_notsupp
  159.                         LEAVE
  160.                     END
  161.                 END
  162.                 UseBrushPalette
  163.                 SetPaintMode 'REPLACE'
  164.                 SetBrushAttributes 'HANDLEX 0 HANDLEY 0'
  165.                 PutBrush 0 0
  166.  
  167.                 GetBrushInfo 'ANNOTATION'
  168.                 IF RC = 0 THEN DO
  169.                     PARSE VALUE RESULT WITH 'LOOP ' loop ' DELAY ' delay .
  170.                     IF DATATYPE(delay, 'W') THEN DO
  171.                         delays = delays delay
  172.                         ticks = TRUNC(delay / 100 * 60 + 0.5)
  173.                         SetFrameDelay ticks
  174.                     END
  175.                 END
  176.  
  177.                 AddFrames
  178.                 SetFramePosition 'NEXT'
  179.                 frame = frame + 1
  180.             END
  181.             ELSE DO
  182.                 IF RC = 38 | (RC = 39 & frame <= 2) THEN
  183.                     err_msg = txt_err_notagif
  184.                 ELSE IF RC = 46 | RC = 47 THEN
  185.                     err_msg = txt_err_oldlib
  186.                 ELSE IF RC ~= 39 THEN
  187.                     err_msg = txt_err_load
  188.                 LEAVE
  189.             END
  190.         END
  191.  
  192.         annot = ''
  193.         LoadBrush gfile 'QUIET NOPROGRESS'    /* reset to normal load (AUTO) */
  194.         IF RC = 0 THEN DO
  195.             GetBrushInfo 'ANNOTATION'
  196.             IF RC = 0 THEN
  197.                 annot = RESULT
  198.         END
  199.         FreeBrush 'FORCE'
  200.         DeleteFrames
  201.  
  202.         IF err_msg ~= '' THEN DO
  203.             RequestNotify 'PROMPT "'err_msg'"'
  204.             FreeEnvironment 'FORCE'
  205.         END
  206.         ELSE DO
  207.             SetFramePosition 1
  208.             IF RC = 0 THEN DO
  209.                 IF getbsh THEN DO
  210.                     Get 'TRANSP'
  211.                     sv_transp = RESULT
  212.  
  213.                     IF transp = 1 THEN
  214.                         Set '"TRANSP=' transp '"'
  215.                     ELSE
  216.                         Set '"TRANSP=0"'
  217.                     GetFrames
  218.                     DefineBrush 0 0 brushw-1 brushh-1 RESULT
  219.                     IF RC = 0 THEN DO
  220.                         FreeEnvironment 'FORCE'
  221.                         SetBrushInfo 'ANNOTATION "LOOP' loop 'DELAY' delays'"'
  222.                         IF annot ~= '' THEN DO
  223.                             pos = 1
  224.                             DO FOREVER
  225.                                 pos = INDEX(annot, '"', pos)
  226.                                 IF pos = 0 THEN
  227.                                     BREAK
  228.                                 annot = INSERT('"', annot, pos)
  229.                                 pos = pos + 2
  230.                             END
  231.                             SetBrushInfo 'COPYRIGHT "'annot'"'
  232.                         END
  233.                     END
  234.  
  235.                     Set '"TRANSP=' sv_transp '"'
  236.                 END
  237.                 ELSE Play 'FORCE'
  238.             END
  239.         END
  240.         Set '"GCLIP='saveclip'"'
  241.     END
  242. END
  243. UnlockGUI
  244.  
  245. EXIT 0
  246.  
  247.  
  248.  
  249.  
  250. SetScreenFormat: PROCEDURE
  251.  
  252.     width  = ARG(1)
  253.     height = ARG(2)
  254.     cnum   = ARG(3)
  255.  
  256.     IF ARG(4) ~= 0 THEN
  257.         GetBestVideoMode width height cnum 'ANIMATION'
  258.     ELSE
  259.         GetBestVideoMode width height cnum
  260.  
  261.     IF RC = 0 THEN DO
  262.         PARSE VAR RESULT scrd scrw scrh
  263.         Set '"IMAGEW='width'" "IMAGEH='height'" "COLORS='cnum'" "DISPLAY='scrd'" "SCREENW='scrw'" "SCREENH='scrh'" "ASCROLL=0"'
  264.     END
  265.  
  266.     RETURN RC
  267.  
  268.  
  269.  
  270.  
  271. SaveSet: PROCEDURE
  272.     sname = ARG(1)
  273.     val = ARG(2)
  274.  
  275.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'W') THEN DO
  276.         CALL WRITECH('settingfile', val)
  277.         CALL CLOSE('settingfile')
  278.     END
  279.  
  280.     RETURN
  281.  
  282.  
  283.  
  284.  
  285. LoadSet: PROCEDURE
  286.     sname = ARG(1)
  287.     val = ARG(2)
  288.  
  289.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'R') THEN DO
  290.         val = READCH('settingfile', 65535)
  291.         CALL CLOSE('settingfile')
  292.     END
  293.  
  294.     RETURN val
  295.